perm filename TMP[0,BGB] blob
sn#116868 filedate 1974-08-30 generic text, type T, neo UTF8
Example 4 - Make Regular Tetrahedron.{λ7;W100;JAF3}
BEGIN "EXAMPLE FOUR"
REQUIRE "GEOMES.HDR[GEM,HE]" SOURCE_FILE; αα GEOMED EMBEDDED IN SAIL;
DEFINE αα="COMMENT";DEFINE PI="3.1415927";
INTEGER PROCEDURE MKTETRA (REAL R); αα MAKE TETRAHEDRON;
BEGIN "MKTETRA"
INTEGER B,F1,F2,V1,V2,V3,V4;
B ← MKBFV; F1 ← PFACE(B); V1 ← PVT(B); αα MAKE POINT POLYHDERA;
XWC(V1) ← ABS(R*0.942809); ZWC(V1) ← -ABS(R/3); αα POSITION FIRST VERTEX;
V2 ← MKEV(F1,V1); ROTATE(V2,0,0,2*PI/3); αα MAKE AND POSITION 2ND VERTEX;
V3 ← MKEV(F1,V2); ROTATE(V3,0,0,2*PI/3); αα MAKE AND POSITION 3RD VERTEX;
V4 ← MKEV(F1,V3); αα MAKE AND POSITION 4TH VERTEX;
XWC(V4)←YWC(V4)←0;ZWC(V4)←ABS(R);
MKFE(V1,F1,V4); F2 ← PFACE(F1); αα CLOSE SKEW QUADRILATERAL;
MKFE(V1,F1,V3); MKFE(V2,F2,V4);
RETURN(B); αα RETURN THE CREATION;
END "MKTETRA";
MKUNIV; MKTETRA(6); αα INITIALIZE AND TEST MKTETRA;
GEODPY; αα DISPLAY REFRESH;
END "EXAMPLE FOUR";{λ30;W0,1260,0,1900;JUFA}
Example 5 - Glue two N-edged faces together.{λ7;W100;JAF3}
BEGIN "EXAMPLE FIVE"
REQUIRE "GEOMES.HDR[GEM,HE]" SOURCE_FILE; αα GEOMED EMBEDDED IN SAIL;
DEFINE αα="COMMENT"; DEFINE PI="3.1415927";
INTEGER B1,B2; αα TWO TEST CUBES;
INTEGER PROCEDURE GLUEFF(INTEGER FACE1,FACE2); αα DEMO GLUE FACE TO FACE;
BEGIN "GLUEFF"
INTEGER V,V1,V2,E,E0,I; REAL DMIN,D;
V1 ← VCCW(PED(FACE1),FACE1); αα PICK ONE VERTEX OF FACE1;
αα FIND VERTEX OF FACE2 THAT IS CLOSEST TO V1;
DMIN ← 10@10; E ← E0 ← PED(FACE2); αα INITIALIZE MINIMAL DISTANCE;
DO BEGIN
V ← VCCW(E,FACE2);D ← DISTAN(V1,V); αα SCAN FACE2 FOR VERTEX CLOSEST TO V1;
IF Dα<DMIN THEN BEGIN DMIN←D;V2←V;END;
END UNTIL E0 = (E←ECCW(E,FACE2));
αα MAKE THE WASP EDGE;
E ← GLUEE(FACE1,V1,FACE2,V2); αα FACE2 AND BODY ARE KILLED;
αα CLOSE OTHER EDGES;
V ← OTHER(NCCW(E),V1); αα LAST VERTEX, TO STOP SCAN;
DO BEGIN
V1 ← OTHER(PCW(E),V1); αα FETCH NEXT PAIR OF VERTICES;
V2 ← OTHER(PCCW(E),V2);
E ← MKFE(V1,FACE1,V2); αα CLOSE AN EDGE;
END UNTIL V=V1;
RETURN(BGET(E)); αα RETURN THE SURVIVING BODY;
END "GLUEFF";
MKUNIV; αα INITIALIZATION;
B1 ← MKCUBE(2,2,2); B2 ← MKCUBE(3,3,3); αα TWO TEST CUBES;
ROTATE(B1,0,-PI/2,0);TRANSL(B1,-3,0,0); αα ORIENT CUBES SO FIRST FACES...;
ROTATE(B2,0,+PI/2,0);TRANSL(B2,+4,0,0); αα ...ARE OPPOSITE;
GLUEFF(PFACE(B1),PFACE(B2)); αα TEST THE FUNCTION;
GEODPY; αα DISPLAY REFRESH;
END "EXAMPLE FIVE";{λ30;W0,1260,0,1900;JUFA}